home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1988-10-02 | 20.1 KB | 679 lines |
- IMPLEMENTATION MODULE mtest;
-
-
- FROM RandomNumbers IMPORT Seed,Random;
- FROM InOut IMPORT WriteLn,WriteString,ReadString,WriteInt,WriteCard;
- FROM Strings IMPORT String,Length,Concat;
- FROM SYSTEM IMPORT ADDRESS,WORD,NULL,ADR;
- IMPORT Terminal; (* conflict with DOSFiles.Write *)
- FROM Pens IMPORT SetAPen,SetDrMd,Move;
- FROM Text IMPORT Text;
- FROM myscreen IMPORT RP, ourwindow;
- FROM mdraw IMPORT drawpixel,drawstats,addressbits,databits;
- FROM Rasters IMPORT ScrollRaster;
- FROM Intuition IMPORT IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet,
- SelectDown, MenuDown;
- FROM Ports IMPORT GetMsg, ReplyMsg, MessagePtr, WaitPort;
- FROM DOSFiles IMPORT Open,Close,Write,FileHandle,ModeNewFile;
- FROM Tasks IMPORT Wait, SIGNAL, SignalSet;
-
-
- TYPE CharSet = SET OF CHAR;
- VAR j,maxvalue,redcard,valuecard:CARDINAL;
- addresscard : LONGCARD;
- response, stringA, stringB, endofline:String;
- i,errorlimit:INTEGER;
- start,end:ADDRESS;
- startmessage,endmessage : String;
- mesg : IntuiMessagePtr;
- actual : LONGINT;
- myfile : FileHandle;
- bitarray : ARRAY[0..15] OF WORD;
- class : IDCMPFlagSet;
- code : CARDINAL;
- ourwindowsignal : SIGNAL;
- ourwindowsignalset,receivedsig : SignalSet;
-
-
- PROCEDURE ConvertChar(ch:CHAR):INTEGER;
- VAR value:INTEGER;
- BEGIN
- IF ch IN CharSet{'0'..'9'} THEN
- value:=ORD(ch)-ORD('0')
- ELSIF ch IN CharSet{'A'..'F'} THEN
- value:=ORD(ch)-ORD('A')+10
- ELSIF ch IN CharSet{'a'..'f'} THEN
- value:=ORD(ch)-ORD('a')+10;
- END;
- RETURN value;
- END ConvertChar;
-
-
- PROCEDURE Convert(s:String):ADDRESS;
- CONST base=16;
- VAR total:ADDRESS;
-
-
- BEGIN
- total:=0;
- FOR i:=0 TO Length(s)-1 DO
- total:=total*base;
- INC(total,ConvertChar(s[i]));
- END;
- RETURN total;
- END Convert;
-
-
- PROCEDURE HexChar(i:INTEGER):CHAR;
- VAR ch:CHAR;
- BEGIN
- IF (i>=0) AND (i<=9) THEN
- ch:=CHR(i+INTEGER(ORD('0')))
- ELSE
- ch:=CHR(i-10+INTEGER(ORD('A')));
- END;
- RETURN(ch);
- END HexChar;
-
-
- PROCEDURE WriteHex(c:CARDINAL;VAR string1,string2:String);
- VAR ch:CHAR;
- constr:String;
- BEGIN
- constr[1]:=CHR(0);
-
- ch:=HexChar(c DIV 4096);
- constr[0]:=ch;
- Concat(string1,constr,string2);
- c:=c MOD 4096;
-
- ch:=HexChar(c DIV 256);
- constr[0]:=ch;
- Concat(string2,constr,string1);
- c:=c MOD 256;
-
- ch:=HexChar(c DIV 16);
- constr[0]:=ch;
- Concat(string1,constr,string2);
- c:=c MOD 16;
-
- ch:=HexChar(c);
- constr[0]:=ch;
- Concat(string2,constr,string1);
- string2:=string1;
- END WriteHex;
-
-
-
- PROCEDURE DoRandom(start,end:ADDRESS;
- errorlimit:INTEGER;
- save,dowrite,message:BOOLEAN);
- TYPE SCALAR=LONGCARD;
- WORDPTR=POINTER TO WORD;
- VAR i : ADDRESS;
- value,red : WORD;
- errors : INTEGER;
- quit : BOOLEAN;
- j : CARDINAL;
- jj : LONGCARD;
-
- BEGIN
- SetAPen(RP,4);
- Move(RP,30,280);
- Text(RP,startmessage,16);
-
- FOR j := 0 TO 23 DO
- addressbits[j] := 0;
- END; (* for *)
-
- FOR j := 0 TO 15 DO
- databits[j] := 0;
- END; (* for *)
-
- IF save THEN
- myfile := Open('ramerr',ModeNewFile);
- END; (* if *);
-
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- WHILE mesg#NULL DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (* while *)
-
- SetAPen(RP,2); (* blue *)
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,370);
- Text(RP,
- ' --------- CLICK LEFT MOUSE BUTTON TO STOP --------- ',
- 50);
- Move(RP,20,380);
- Text(RP,
- ' --------- HOLD RIGHT MOUSE BUTTON TO PAUSE -------- ',
- 50);
-
- IF dowrite THEN
- Seed(10);
- i:=start;
- jj:=LONGCARD(i MOD 65536);
- quit := FALSE;
- WHILE (i<=end) AND NOT quit DO
- drawpixel(i,6);
- WHILE (jj>1) AND (i<=end) DO
- i^:=WORD(Random(65535));
- INC(i,2);
- DEC(jj,2);
- END; (* while *)
- jj:=65536;
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- IF mesg#NULL THEN (* user wants to quit *)
- ReplyMsg(MessagePtr(mesg));
- quit := TRUE;
- END; (* if *)
- END; (* while *)
- END; (* if *)
-
- Seed(10);
- i:=start;
- drawpixel(i,2);
- errors:=0;
- SetAPen(RP,3); (* red *)
- WHILE (i<=end) AND (errors<errorlimit) AND NOT quit DO
- value:=WORD(Random(65535));
- red:=WORD(i^);
- IF CARDINAL(red) # CARDINAL(value) THEN (* have found and error *)
- IF save OR message THEN
- stringA := 'BAD Location, address - ';
-
- WriteHex(CARDINAL(i DIV 65536),stringA,stringB);
- WriteHex(CARDINAL(i MOD 65536),stringB,stringA);
-
- Concat(stringA,'H Written - ',stringB);
-
- WriteHex(CARDINAL(value),stringB,stringA);
-
- Concat(stringA,'H Read - ',stringB);
-
- WriteHex(CARDINAL(red),stringB,stringA);
-
- Concat(stringA,'H',stringB);
- END; (* if *)
-
-
- IF message THEN
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,380);
- Text(RP,stringB,Length(stringB));
- END; (* if *)
-
- IF save AND (myfile<>LONGCARD(0)) THEN
- Concat(stringB,endofline,stringA);
- actual := Write(myfile,ADR(stringA),LONGCARD(Length(stringA)));
- END; (* if *)
-
- INC(errors);
-
- drawpixel(i,3);
-
- addresscard := LONGCARD(i);
- FOR j:= 0 TO 23 DO
- IF addresscard MOD 2 > 0 THEN
- INC(addressbits[j]);
- END; (* if *)
- addresscard := addresscard DIV 2;
- END; (* for *)
-
- valuecard := CARDINAL(value);
- redcard := CARDINAL(red);
-
- FOR j:= 0 TO 15 DO
- IF (valuecard MOD 2) # (redcard MOD 2) THEN
- INC(databits[j]);
- END; (* if *)
- valuecard := valuecard DIV 2;
- redcard := redcard DIV 2;
- END; (* for *)
-
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- IF mesg # NULL THEN (* user wants to quit *)
- class:=mesg^.Class;
- code :=mesg^.Code;
- IF IDCMPFlags(MouseButtons) IN class THEN
- IF SelectDown = code THEN
- (* WriteString('Selectdown detected and replied');
- WriteLn;*)
- ReplyMsg(MessagePtr(mesg));
- quit:=TRUE;
- SetAPen(RP,2); (* blue *)
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,380);
- Text(RP,
- ' -------- OPERATION ABORTED BY USER -------- ',
- 50);
- ELSIF MenuDown = code THEN
- (* WriteString('MenuDown detected and replied');
- WriteLn;*)
- ReplyMsg(MessagePtr(mesg));
- mesg:=IntuiMessagePtr(WaitPort(ourwindow^.UserPort));
- WHILE mesg # NULL DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (* while *)
- END; (* elsif *)
- ELSE
- ReplyMsg(MessagePtr(mesg));
- (* WriteString('Non mouse message recieved and replied');
- WriteLn;*)
- END; (* else *)
-
- END; (* if received intuimessage *)
-
- END; (* if not same *)
-
- INC(i,2);
- IF i MOD 65536 = 0 THEN
- drawpixel(i,2);
- END;
- END;
-
- IF save AND (myfile<>LONGCARD(0)) THEN
- Close(myfile);
- END; (* if *)
-
- drawstats;
-
- SetAPen(RP,4);
- Move(RP,30,280);
- Text(RP,endmessage,16);
- END DoRandom;
-
-
-
- PROCEDURE DoLinear(start,end:ADDRESS;
- errorlimit:INTEGER;
- save,dowrite,message:BOOLEAN);
- VAR i:ADDRESS;
- value:WORD;
- errors:INTEGER;
- quit:BOOLEAN;
- j:CARDINAL;
- jj:LONGCARD;
-
- BEGIN
- SetAPen(RP,4);
- Move(RP,30,280);
- Text(RP,startmessage,16);
-
- FOR j := 0 TO 23 DO
- addressbits[j] := 0;
- END; (* for *)
-
- FOR j := 0 TO 15 DO
- databits[j] := 0;
- END; (* for *)
-
- IF save THEN
- myfile := Open('ramerr',ModeNewFile);
- END; (* if *);
-
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- WHILE mesg#NULL DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (* while *)
-
- SetAPen(RP,2); (* blue *)
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,370);
- Text(RP,
- ' --------- CLICK LEFT MOUSE BUTTON TO STOP --------- ',
- 50);
- Move(RP,20,380);
- Text(RP,
- ' --------- HOLD RIGHT MOUSE BUTTON TO PAUSE -------- ',
- 50);
-
- IF dowrite THEN
- Seed(10);
- i:=start;
- jj:=LONGCARD(i MOD 65536);
- quit := FALSE;
- WHILE (i<=end) AND NOT quit DO
- drawpixel(i,6);
- WHILE (jj>1) AND (i<=end) DO
- i^:=WORD(i DIV 2);
- INC(i,2);
- DEC(jj,2);
- END; (* while *)
- jj:=65536;
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- IF mesg#NULL THEN (* user wants to quit *)
- ReplyMsg(MessagePtr(mesg));
- quit := TRUE;
- END; (* if *)
- END; (* while *)
- END; (* if *)
-
-
- i:=start;
- drawpixel(i,2);
- errors:=0;
- SetAPen(RP,3);
- WHILE (i<=end) AND (errors<errorlimit) AND NOT quit DO
- value:=WORD(i^);
- IF CARDINAL(value) # CARDINAL(i DIV 2) THEN
- IF save OR message THEN
- stringA := 'BAD Location, address - ';
-
- WriteHex(CARDINAL(i DIV 65536),stringA,stringB);
- WriteHex(CARDINAL(i MOD 65536),stringB,stringA);
-
- Concat(stringA,'H Written - ',stringB);
-
- WriteHex(CARDINAL(i DIV 2),stringB,stringA);
-
- Concat(stringA,'H Read - ',stringB);
-
- WriteHex(CARDINAL(value),stringB,stringA);
-
- Concat(stringA,'H',stringB);
- END; (* if *)
-
-
- IF message THEN
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,380);
- Text(RP,stringB,Length(stringB));
- END; (* if *)
-
- IF save AND (myfile<>LONGCARD(0)) THEN
- Concat(stringB,endofline,stringA);
- actual := Write(myfile,ADR(stringA),LONGCARD(Length(stringA)));
- END; (* if *)
-
- INC(errors);
-
- drawpixel(i,3);
-
- addresscard := LONGCARD(i);
- FOR j:= 0 TO 23 DO
- IF addresscard MOD 2 > 0 THEN
- INC(addressbits[j]);
- END; (* if *)
- addresscard := addresscard DIV 2;
- END; (* for *)
-
- valuecard := CARDINAL(i DIV 2);
- redcard := CARDINAL(value);
-
- FOR j:= 0 TO 15 DO
- IF (valuecard MOD 2) # (redcard MOD 2) THEN
- INC(databits[j]);
- END; (* if *)
- valuecard := valuecard DIV 2;
- redcard := redcard DIV 2;
- END; (* for *)
-
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- IF mesg # NULL THEN (* user wants to quit *)
- class:=mesg^.Class;
- code :=mesg^.Code;
- IF IDCMPFlags(MouseButtons) IN class THEN
- IF SelectDown = code THEN
- (* WriteString('Selectdown detected and replied');
- WriteLn;*)
- ReplyMsg(MessagePtr(mesg));
- quit:=TRUE;
- SetAPen(RP,2); (* blue *)
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,380);
- Text(RP,
- ' -------- OPERATION ABORTED BY USER -------- ',
- 50);
- ELSIF MenuDown = code THEN
- (* WriteString('MenuDown detected and replied');
- WriteLn;*)
- ReplyMsg(MessagePtr(mesg));
- mesg:=IntuiMessagePtr(WaitPort(ourwindow^.UserPort));
- WHILE mesg # NULL DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (* while *)
- END; (* elsif *)
- ELSE
- ReplyMsg(MessagePtr(mesg));
- (* WriteString('Non mouse message recieved and replied');
- WriteLn;*)
- END; (* else *)
-
- END; (* if received intuimessage *)
-
- END; (* if not same *)
-
- INC(i,2);
- IF i MOD 65536 = 0 THEN
- drawpixel(i,2);
- END;
- END;
-
- IF save AND (myfile<>LONGCARD(0)) THEN
- Close(myfile);
- END; (* if *)
-
- drawstats;
-
- SetAPen(RP,4);
- Move(RP,30,280);
- Text(RP,endmessage,16);
- END DoLinear;
-
-
-
- PROCEDURE DoBits(start,end:ADDRESS;
- errorlimit:INTEGER;
- save,dowrite,message:BOOLEAN);
- VAR i:ADDRESS;
- value:WORD;
- errors:INTEGER;
- quit:BOOLEAN;
- j:CARDINAL;
- jj:LONGCARD;
-
- BEGIN
- SetAPen(RP,4);
- Move(RP,30,280);
- Text(RP,startmessage,16);
-
- FOR j := 0 TO 23 DO
- addressbits[j] := 0;
- END; (* for *)
-
- FOR j := 0 TO 15 DO
- databits[j] := 0;
- END; (* for *)
-
- IF save THEN
- myfile := Open('ramerr',ModeNewFile);
- END; (* if *);
-
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- WHILE mesg#NULL DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (* while *)
-
- SetAPen(RP,2); (* blue *)
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,370);
- Text(RP,
- ' --------- CLICK LEFT MOUSE BUTTON TO STOP --------- ',
- 50);
- Move(RP,20,380);
- Text(RP,
- ' --------- HOLD RIGHT MOUSE BUTTON TO PAUSE -------- ',
- 50);
-
- IF dowrite THEN
- Seed(10);
- i:=start;
- jj:=LONGCARD(i MOD 65536);
- quit := FALSE;
- WHILE (i<=end) AND NOT quit DO
- drawpixel(i,6);
- WHILE (jj>1) AND (i<=end) DO
- i^:=bitarray[CARDINAL((i DIV 2) MOD 16)];
- INC(i,2);
- DEC(jj,2);
- END; (* while *)
- jj:=65536;
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- IF mesg#NULL THEN (* user wants to quit *)
- ReplyMsg(MessagePtr(mesg));
- quit := TRUE;
- END; (* if *)
- END; (* while *)
- END; (* if *)
-
- i:=start;
- drawpixel(i,2);
- errors:=0;
- SetAPen(RP,3);
- WHILE (i<=end) AND (errors<errorlimit) AND NOT quit DO
- value:=WORD(i^);
- IF CARDINAL(value) # CARDINAL(bitarray[CARDINAL((i DIV 2) MOD 16)]) THEN
- IF save OR message THEN
- stringA := 'BAD Location, address - ';
-
- WriteHex(CARDINAL(i DIV 65536),stringA,stringB);
- WriteHex(CARDINAL(i MOD 65536),stringB,stringA);
-
- Concat(stringA,'H Written - ',stringB);
-
- WriteHex(CARDINAL(bitarray[CARDINAL((i DIV 2) MOD 16)]),stringB,stringA);
-
- Concat(stringA,'H Read - ',stringB);
-
- WriteHex(CARDINAL(value),stringB,stringA);
-
- Concat(stringA,'H',stringB);
- END; (* if *)
-
-
- IF message THEN
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,380);
- Text(RP,stringB,Length(stringB));
- END; (* if *)
-
- IF save AND (myfile<>LONGCARD(0)) THEN
- Concat(stringB,endofline,stringA);
- actual := Write(myfile,ADR(stringA),LONGCARD(Length(stringA)));
- END; (* if *)
-
- INC(errors);
-
- drawpixel(i,3);
-
- addresscard := LONGCARD(i);
- FOR j:= 0 TO 23 DO
- IF addresscard MOD 2 > 0 THEN
- INC(addressbits[j]);
- END; (* if *)
- addresscard := addresscard DIV 2;
- END; (* for *)
-
- valuecard := CARDINAL(i DIV 2);
- redcard := CARDINAL(value);
-
- FOR j:= 0 TO 15 DO
- IF (valuecard MOD 2) # (redcard MOD 2) THEN
- INC(databits[j]);
- END; (* if *)
- valuecard := valuecard DIV 2;
- redcard := redcard DIV 2;
- END; (* for *)
-
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- IF mesg # NULL THEN (* user wants to quit *)
- class:=mesg^.Class;
- code :=mesg^.Code;
- IF IDCMPFlags(MouseButtons) IN class THEN
- IF SelectDown = code THEN
- (* WriteString('Selectdown detected and replied');
- WriteLn;*)
- ReplyMsg(MessagePtr(mesg));
- quit:=TRUE;
- SetAPen(RP,2); (* blue *)
- ScrollRaster(RP,0,10,0,300,639,399);
- Move(RP,20,380);
- Text(RP,
- ' -------- OPERATION ABORTED BY USER -------- ',
- 50);
- ELSIF MenuDown = code THEN
- (* WriteString('MenuDown detected and replied');
- WriteLn;*)
- ReplyMsg(MessagePtr(mesg));
- mesg:=IntuiMessagePtr(WaitPort(ourwindow^.UserPort));
- WHILE mesg # NULL DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (* while *)
- END; (* elsif *)
- ELSE
- ReplyMsg(MessagePtr(mesg));
- (* WriteString('Non mouse message recieved and replied');
- WriteLn;*)
- END; (* else *)
-
- END; (* if received intuimessage *)
-
- END; (* if not same then *)
-
- INC(i,2);
- IF i MOD 65536 = 0 THEN
- drawpixel(i,2);
- END; (* if *)
-
- END;
-
- IF save AND (myfile<>LONGCARD(0)) THEN
- Close(myfile);
- END; (* if *)
-
- drawstats;
-
- SetAPen(RP,4);
- Move(RP,30,280);
- Text(RP,endmessage,16);
- END DoBits;
-
-
-
-
- BEGIN (* memorytest *)
- startmessage := 'Doing Test Now...';
- endmessage := 'Test Completed. ';
- endofline[0] := CHR(10);
- endofline[1] := CHR(0);
-
- bitarray[0] := WORD(1);
- FOR j:=1 TO 15 DO
- bitarray[j]:=WORD(CARDINAL(bitarray[j-1])*2);
- END; (* for *);
-
- ourwindowsignal:=1;
- FOR j:= 1 TO CARDINAL(ourwindow^.UserPort^.mpSigBit) DO
- ourwindowsignal := ourwindowsignal * 2;
- END; (* for *)
- ourwindowsignalset := SignalSet{};
- INCL(ourwindowsignalset,ourwindowsignal);
-
- END mtest.
-
- (* receivedsig := Wait(ourwindowsignalset); *)
-